
(*******************************************
	Visual representation of a context 
	tree view of context used througout implementation 
*********************************************)
open Utils.Pervasive
open Utils.Error
open Syntax
open Binding
open PrintExpr
open Core

open Expr_visual
open GPUtils

open GMain
open Gobject.Data
open StdLabels
open GtkTree 


let current_model_context = ref empty_context
let cols = new GTree.column_list
let expr_str = cols#add string
let visible = cols#add boolean
let world = cols#add boolean
let bg = cols#add (unsafe_boxed (Gobject.Type.from_name "GdkColor"))



let rec make_top_level ctx = 
   let list_element str = (str , false) in
   let header i =
		let bind = get_binding ctx i in
		begin match bind with
		| BoundedTyVarBind -> [list_element " a type variable"]
		| TyVarBind ->  [list_element " an atomic type"]
		| BoundedTeVarBind ty -> 
			[list_element ( " a term variable of type " ^ 
								string_of_type ctx ty Alpha)]
		| TeVarBind ty -> 
			[list_element (" an atomic term of type " ^ 
								string_of_type ctx ty Alpha)]
		| TyAbbBind ty -> [list_element(" a name for the type " ^ string_of_type ctx ty Alpha)]
        | TmAbbBind( te , defTy )->
			[list_element(" a name for the term \n\t" ^ string_of_term ctx te Alpha) ;
			list_element("of deduced type from context: " ^ string_of_type ctx ( typeof ctx te) Alpha);
				begin match defTy with
				| None -> list_element("of no defined type")
				|Some ty -> list_element("of defined type: " ^ string_of_type ctx ty Alpha)
				end]          
         end
     in 
     let rec makelist lst ctx' i= 
			match ctx' with 
			| [] ->  lst
			| (str , bind) :: rest -> makelist ((str , header i) :: lst) rest (i+1)
	 in  
     makelist [] ctx 0 

let create_model ctx ( ) =
	current_model_context := ctx;
	let model = GTree.tree_store cols in
	List.iter (make_top_level ctx) ~f:
    begin fun (str, info) ->
      let row = model#append () in
      model#set ~row ~column:expr_str str;
      List.iter info ~f:
        begin fun (n , w) ->
          let row = model#append ~parent:row () in
          let set column = model#set ~row ~column in
          set expr_str n;
          set visible true;
          set world w;
          set bg (GDraw.color (`NAME "orange"))
        end;
    end;
  model

let item_toggled ~(model : GTree.tree_store) ~column path =
  let row = model#get_iter path in
  let b = model#get ~row ~column in
  model#set ~row ~column (not b);
  ()
 

let on_row_activated (view:GTree.view) path column =
	let model = view#model in
	let row = model#get_iter path in
	let name = model#get ~row ~column:expr_str in
	let ctx =  !current_model_context in 
	let expr = expr_of_name ctx name in
	show_expr_window ctx (RawExpression expr) ();
	Printf.printf "Double-clicked row contains name %s\n" name;
	flush stdout
 
   
let add_columns ~(view : GTree.view) ~model =
  let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
  let vc =
    GTree.view_column ~title:"Expressions" ~renderer:(renderer, ["text", expr_str]) ()
  in
  vc#add_attribute renderer "background-gdk" bg;
  un(view#append_column vc);

  List.iter [] ~f:
    begin fun (title, column, euro) ->
      let renderer = GTree.cell_renderer_toggle [`XALIGN 0.] in
      un(renderer#connect#toggled ~callback:(item_toggled ~model ~column));
      let attrs =
        if euro then
          ["active", column; "visible", visible; "activatable", world]
        else ["active", column; "visible", visible]
      in
      let vc = GTree.view_column ~title ~renderer:(renderer, attrs) () in
      un(view#append_column vc);
      vc#set_sizing `FIXED;
      vc#set_fixed_width 50;
      vc#set_clickable true;
    end

 
let bind_ctx_to_view (tview : GTree.view) ctx = 
	let mod_of_st st = (st : GTree.tree_store :> GTree.model) in
		let t_store = create_model ctx () in
		let model = mod_of_st t_store in
		tview#set_model (Some model)
	

let init_view (tv : GTree.view)  = 
	 let model = create_model empty_context () in
	 tv#set_model None;
     tv#set_rules_hint true;
     tv#selection#set_mode `MULTIPLE;  
	 add_columns ~view:tv ~model;
	 un(tv#connect#row_activated ~callback:(on_row_activated tv));
 
	 tv   
	

